home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ws_enc1a / crypt.bas next >
Encoding:
BASIC Source File  |  1999-10-09  |  3.5 KB  |  97 lines
  1. Attribute VB_Name = "modCrypt"
  2. Public Function WS_Decrypt(CypherText As String)
  3.  
  4.  
  5. On Error GoTo ErrorH
  6. Dim caracter As String
  7. Dim sal As String
  8. Dim DeHexed As Integer
  9. Dim salmod As Integer
  10. Dim salaug As Integer
  11. Dim passw As String
  12. frmWs_Encrypt.Text1(3) = ""
  13. Debug.Print                   'This function generates a debug report of the process. WS_Encrypt doesn't.
  14. Debug.Print "---Decrypt---"
  15. Debug.Print Now2
  16.     
  17.     passw = Mid(CypherText, 33, Len(CypherText) - 32) 'First character of passw is actually a placeholder, because of the way the next DO/Loop works
  18.  
  19.     I = 1
  20.     Do While I < Len(passw) / 2         'divided by two because the hex is in two didgit format
  21.         caracter = Mid(passw, I * 2, 2) 'I translated this from a javascript written in spanish.
  22.         sal = Mid(CypherText, 1 + I, 1) 'sal = salt
  23.         DeHexed = modMath.C_HexInt(caracter)  'modMath.C_HexInt turns hex string to integers
  24.         DeHexedMinPos = DeHexed - I         'These four line are the actual cipher
  25.         salaug = 47 + modMath.C_HexInt(sal)
  26.         salmod = salaug Mod 57              'Mod is an operator. Check the help file for more info.
  27.         claro = DeHexedMinPos - salmod
  28.         WS_Decrypt = WS_Decrypt & Chr(claro)
  29.         
  30.         Debug.Print "For Letter '" & Chr(claro) & "' at pos " & I
  31.         Debug.Print "   Hex caracter = "; caracter & "; Hex Salt: "; sal & "; DeHex caracter = " & DeHexed & "; DeHex caracter - Pos = "; DeHexedMinPos
  32.         Debug.Print "   salaug 47 = " & salaug & "; Salaug Mod 57 = " & salmod & "; MinPos - (Salaug Mod 57) = " & claro & "; Current Decrypted Str = " & WS_Decrypt
  33.         I = I + 1
  34.     Loop
  35.  
  36. Exit Function
  37. ErrorH:
  38. frmWs_Encrypt.Text1(3) = "Getting Error " & Err.Number & ":" & Err.Description 'You might want to take this out for your program.
  39.  
  40. End Function
  41.  
  42. Public Function WS_Encrypt(PlainText)
  43. On Error GoTo ErrorH
  44.  
  45. Dim iSalt(32) As Integer
  46. Dim sSalt(32) As String
  47. Dim sLetterHex(32) As String
  48. frmWs_Encrypt.Text1(3) = ""
  49.     
  50.     Randomize Timer
  51.  
  52.     For I = 1 To 32             'Generate 32 salt values in hex and int. More then you will usually need.
  53.         iRand = Int(Rnd * 16)
  54.         sHex = Hex(iRand)
  55.         iSalt(I) = iRand
  56.         sSalt(I) = sHex
  57.     Next I
  58.     
  59.     For I = 1 To Len(PlainText)     'This loop is the cipher that encrypts each letter of plaintext into ciphertext using the random salt value and letter position.
  60.         iLetter = Asc(Mid(PlainText, I, 1))
  61.         SaltPlus = iSalt(I) + 47
  62.         SaltPlus = SaltPlus Mod 57
  63.         iLetter = iLetter + SaltPlus
  64.         iLetter = iLetter + I
  65.         sLetterHex(I) = Hex(iLetter)
  66.     Next I
  67.     
  68.     sEncrypted = "V"                'V is always the first character. Probably has to do with the name of the cypher.
  69.     
  70.     For I = 1 To Len(PlainText)
  71.         Debug.Print "Salt Val: " & iSalt(I) & " SaltHex: " & sHex
  72.         sEncrypted = sEncrypted & sSalt(I)  'Append salt for each letter
  73.     Next I
  74.     
  75.     numX = 32 - (Len(sEncrypted) - 1)
  76.     
  77.     For I = 1 To numX
  78.         sEncrypted = sEncrypted & "X"       'Append placeholders
  79.     Next I
  80.     
  81.     Debug.Print "NumX = " & I
  82.     
  83.  
  84.     
  85.     For I = 1 To 32
  86.         sEncrypted = sEncrypted & sLetterHex(I) 'Append double didgit hex. This is the ascii value of the encrypted password.
  87.     Next I
  88.     
  89.     WS_Encrypt = sEncrypted                     'Return
  90.  
  91. Exit Function
  92. ErrorH:
  93. frmWs_Encrypt.Text1(3) = "Getting Error " & Err.Number & ":" & Err.Description 'You might want to take this out for your program.
  94.  
  95. End Function
  96.  
  97.